home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / misc~1 / 5 / osspascl / copy2.pas < prev    next >
Pascal/Delphi Source File  |  1985-11-19  |  3KB  |  106 lines
  1. PROGRAM copy2_pas ;
  2.  
  3. {Written in OSS Personal Pascal -- original from OSS -- revision by
  4.  David Duberman  3/86}
  5.  
  6. {Copies list of files in ASCII text file FILE.LST in root directory
  7. to drive C: -- Place in AUTO folder after copying ramdisk utility into
  8. folder}
  9.  
  10.   CONST
  11.     chunk_size = 32000 ;
  12.     fn_length = 64 ;
  13.  
  14.   TYPE
  15.     buffer_type = PACKED ARRAY [ 1..chunk_size ] OF byte ;
  16.     file_name_type = PACKED ARRAY [ 1..fn_length ] OF char ;
  17.  
  18.   VAR
  19.     fname : STRING ;
  20.     buf : buffer_type ;
  21.     i,j,in_file, out_file : integer ;
  22.     name : file_name_type ;
  23.     t: text;
  24.  
  25.   FUNCTION gem_create( VAR fname : file_name_type ; mode : integer ) : integer;
  26.     GEMDOS( $3C ) ;
  27.  
  28.   FUNCTION gem_open( VAR fname : file_name_type ; mode : integer ) : integer;
  29.     GEMDOS( $3D ) ;
  30.  
  31.   PROCEDURE gem_close( handle : integer ) ;
  32.     GEMDOS( $3E ) ;
  33.  
  34.   FUNCTION gem_read( handle : integer ; nbytes : long_integer ;
  35.                 VAR buf : buffer_type ) : long_integer ;
  36.     GEMDOS( $3F ) ;
  37.  
  38.   FUNCTION gem_write( handle : integer ; nbytes : long_integer ;
  39.                 VAR buf : buffer_type ) : long_integer ;
  40.     GEMDOS( $40 ) ;
  41.  
  42.   PROCEDURE gem_seek( nbytes : long_integer ; handle, mode : integer ) ;
  43.     GEMDOS( $42 ) ;
  44.  
  45.  
  46.   PROCEDURE copy_file( in_file, out_file : integer ) ;
  47.  
  48.     VAR
  49.       n : long_integer ;
  50.  
  51.     BEGIN
  52.       REPEAT
  53.         n := gem_read( in_file, chunk_size, buf ) ;
  54.         {writeln( 'read chunk of ', n, ' bytes' ) ;}
  55.         IF n < 0 THEN
  56.           BEGIN
  57.             writeln( 'error ', n, ' on input file' ) ;
  58.             halt ;
  59.           END
  60.         ELSE IF n > 0 THEN
  61.           IF gem_write( out_file, n, buf ) <> n THEN
  62.             BEGIN
  63.               writeln( 'error writing output file' ) ;
  64.               halt ;
  65.             END ;
  66.       UNTIL n = 0 ;
  67.     END ;
  68.  
  69.   BEGIN
  70.   Writeln; Writeln('Fast File Copy Utility'); Writeln;
  71.   Writeln('Written in OSS Personal Pascal'); Writeln;
  72.   Writeln('Portions copyright (c) 1986 OSS & CCD'); Writeln;
  73.   Writeln('Used by permission of OSS'); Writeln;
  74.   Reset(t,'file.lst');
  75.   while not eof(t) do begin
  76.     readln(t,fname);
  77.     writeln;
  78.     writeln('Copying ',fname);
  79.     FOR i := 1 TO length( fname ) DO
  80.       name[i] := fname[i] ;
  81.     name[ length(fname) + 1 ] := chr(0) ;
  82.     in_file  := gem_open( name, 0 ) ;
  83.     IF in_file < 0 THEN
  84.       BEGIN
  85.         writeln( 'error ', in_file, ' opening input' ) ;
  86.         halt ;
  87.       END ;
  88.     name[1] := 'c';
  89.     name[2] := ':';
  90.     FOR i := 1 TO length( fname ) DO
  91.       name[i+2] := fname[i] ;
  92.     name[ length(fname) + 3 ] := chr(0) ;
  93.     out_file := gem_create( name, 0 ) ;
  94.     IF out_file < 0 THEN
  95.       BEGIN
  96.         writeln( 'error ', out_file, ' opening output' ) ;
  97.         halt ;
  98.       END ;
  99.     copy_file( in_file, out_file ) ;
  100.     gem_close( in_file ) ;
  101.     gem_close( out_file ) ;
  102.     end;
  103.     close(t)
  104. END.
  105.